home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / info-service / gopher / Rice_CMS / gopher24 / gopsrv.exec < prev    next >
Encoding:
Text File  |  1993-01-22  |  9.4 KB  |  356 lines
  1. /*
  2.  *        Name: GOPSRV EXEC
  3.  *              A CMS-based Gopher Server
  4.  *              Based on the original, GOPHERD EXEC, from 2.3.
  5.  *      Author: Rick Troth, Rice University, Information Systems
  6.  *        Date: 1992-Apr-21, Aug-07, Oct-14, Dec-11, 1993-Jan-15
  7.  */
  8.  
  9. /*
  10.  *      Copyright 1993 Richard M. Troth.   This software was developed
  11.  *      with resources provided by Rice University and is intended
  12.  *      to serve Rice's user community.   Rice has benefitted greatly
  13.  *      from the free distribution of software,  therefore distribution
  14.  *      of unmodified copies of this material is not restricted.
  15.  *      You may change your own copy as needed.   Neither Rice
  16.  *      University nor any of its employees or students shall be held
  17.  *      liable for damages resulting from the use of this software.
  18.  */
  19.  
  20. /*
  21.  *       Calls:
  22.  *              GOPSRVLS REXX     -- to read files and menus
  23.  *              GOPSRVRP REXX     -- to resolve gopher paths
  24.  *              GOPSRVMB REXX     -- to build menus for the client
  25.  *
  26.  *        Note: this program does *not* use RXSOCKET's translation
  27.  *              option.   Translation between ASCII and EBCDIC
  28.  *              is determined by the type of file requested.
  29.  */
  30.  
  31. progid = "CMS Gopher 2.4.0 server"
  32. gopher = "Gopher"
  33. timeout = 5
  34.  
  35. Parse Source . . . . . arg0 .
  36. argo = arg0 || ':'
  37. Parse Upper Arg root port . '(' . ')' .
  38.  
  39. Address "COMMAND"
  40.  
  41. 'SET LANGUAGE (ADD GOP USER'
  42.  
  43. host = "localhost"      /*  this will be reset to the actual name of  *
  44.                          *  this host after RXSOCKET is initialized.  */
  45.  
  46.     stdin  = 0
  47.     stdout = 1
  48.     stderr = 2
  49.  
  50. Say argo progid "starting"
  51.  
  52. logpipe = "CONSOLE"
  53. _root = Userid()
  54. _port = 70
  55. 'PIPE < GOPHERD CONFIG * | STEM CONFIG.'
  56. If rc = 0 Then
  57. Do i = 1 to config.0
  58.     If Left(config.i,1) = '*' Then Iterate
  59.     If Left(config.i,1) = '#' Then Iterate
  60.     If Index(config.i,'=') = 0 Then Iterate
  61.     Parse Var config.i var '=' val
  62.     Upper var
  63.     Select  /*  var  */
  64.         When  Abbrev("LOGPIPE",var,3)   Then  logpipe = val
  65.         When  Abbrev("ROOT",var,4)      Then  _root = val
  66.         When  Abbrev("PORT",var,4)      Then  _port = val
  67.         Otherwise 'XMITMSG 2 VAR (ERRMSG'
  68.         End  /*  Select  var  */
  69.     End  /*  Do  For  */
  70.  
  71. If root = "" Then root = _root
  72. If port = "" Then port = _port
  73.  
  74. If ^Datatype(port,'N') Then Do
  75.     /*  "Gopher TCP/IP service port must be numeric."  */
  76.     'XMITMSG 126 (APPLID GOP CALLER SRV ERRMSG'
  77.     Exit 24
  78.     End  /*  If  ..  Do  */
  79.  
  80. /*
  81.  *   Initialize RXSOCKET
  82.  */
  83. maxdesc = Socket('Initialize', gopher)
  84. If maxdesc = "-1" Then Do
  85.     Say argo tcperror()
  86.     Exit -1
  87.     End  /*  If  ..  Do  */
  88. Say argo "RXSOCKET Initialized for" maxdesc "descriptors"
  89.  
  90.  
  91. /*
  92.  *   Request the name of this host
  93.  */
  94. rc = Socket('GetHostName', 'HOST')
  95. If rc = "-1" Then Do
  96.     Say argo tcperror()
  97.     Exit -1
  98.     End  /*  If  ..  Do  */
  99. Say argo "LocalHost =" host
  100.  
  101.  
  102. /*
  103.  *   Request a new socket descriptor (TCP protocol)
  104.  */
  105. socket = Socket('Socket', 'AF_INET', 'Sock_Stream')
  106. If socket = "-1" Then Do
  107.     Say argo tcperror()
  108.     Exit -1
  109.     End  /*  If  ..  Do  */
  110. Say argo "Primary socket =" socket
  111.  
  112.  
  113. /*
  114.  *   Set this socket to non-blocking mode
  115.  */
  116. rc = Socket('Ioctl', socket, 'FIONBIO', 1)
  117. If rc = "-1" Then
  118.     Say argo tcperror()
  119.  
  120.  
  121. /*
  122.  *
  123.  */
  124. name = AF_INET || Htons(port)
  125.  
  126. rc = Socket('Bind', socket, name)
  127. If rc = "-1" Then Do
  128.     Say argo tcperror()
  129.     Exit -1
  130.     End  /*  If  ..  Do  */
  131. Say argo "Bound to port" port
  132.  
  133.  
  134. /*
  135.  *
  136.  */
  137. rc = Socket('Listen', socket, maxdesc)
  138. If rc = "-1" Then Do
  139.     Say argo tcperror()
  140.     Exit -1
  141.     End  /*  If  ..  Do  */
  142. /*  Say argo "Listening ..."  */
  143.  
  144. /*  UNIX and VMS style logging:  */
  145. Parse Value Date('S') With 1 yy 5 mm 7 dd 9 .
  146. day = Left(Date('W'),3)
  147. mon = Left(Date('M'),3)
  148. time = Time()
  149. userid = Userid()
  150. /*  "Starting gopher daemon" Userid()  */
  151. 'PIPE COMMAND XMITMSG 120 DAY MON DD TIME YY HOST USERID' ,
  152.         '(APPLID GOP CALLER SRV ERRMSG |' logpipe
  153.  
  154. Say argo progid "waiting for a connection"
  155.  
  156. 'GLOBALV SELECT GOPHERD PUT HOST PORT ROOT'
  157.  
  158. Do Forever
  159.  
  160.     rc = FD_ZERO('readmask')            /* must be reset each time */
  161.     rc = FD_SET(socket, 'readmask')
  162.     rc = FD_SET(stdin, 'readmask')
  163.  
  164.     Say "*"     /* waiting */
  165.     rc = Socket('Select', socket + 1, 'readmask', 0, 0, 0)
  166.     If rc = "-1" Then Do
  167.         Say argo tcperror()
  168.         Leave
  169.         End  /*  If  ..  Do  */
  170.  
  171.     If FD_ISSET(stdin, 'readmask') = 1 Then Leave
  172.     If FD_ISSET(socket, 'readmask') ^= 1 Then Iterate
  173.  
  174.     /*
  175.      *
  176.      */
  177.     ns = Socket('Accept', socket, 'CLIENT')
  178.     If ns = "-1" Then Do
  179.         Say argo tcperror()
  180.         Leave
  181.         End  /*  If  ..  Do  */
  182.  
  183.     Say argo "Accepted" ns "at" Time() "client" c2x(client)
  184.     Parse Var client . 5 r1 +1 r2 +1 r3 +1 r4 +1 .
  185.     cipa = c2d(r1) || "." || c2d(r2) || "." || ,
  186.            c2d(r3) || "." || c2d(r4)
  187.     /*  Say argo "Client's IP address is" cipa  */
  188.  
  189.     /*  UNIX and VMS style logging:  */
  190.     Parse Value Date('S') With 1 yyyy 5 mm 7 dd 9 .
  191.     day = Left(Date('W'),3)
  192.     mon = Left(Date('M'),3)
  193.     time = Time()
  194.  
  195.     /*
  196.      *   Loop, reading the query line from the client.
  197.      */
  198.     path = ""
  199.     Do Forever
  200.  
  201.         rc = FD_ZERO('readmask')        /* must be reset each time */
  202.         rc = FD_SET(ns, 'readmask')
  203.  
  204.         rc = Socket('Select', ns + 1, 'readmask', 0, 0, timeout)
  205.         If rc = "-1" Then Do
  206.             Say argo tcperror()
  207.             Exit -1
  208.             End  /*  If  ..  Do  */
  209.  
  210.         If FD_ISSET(ns, 'readmask') ^= 1 Then Leave
  211.  
  212.         pack = ""
  213.         bytes_in = Socket('Read', ns, 'PACK')
  214.         If bytes_in = "-1" Then
  215.             Say argo tcperror()
  216.         If bytes_in < 1 Then Leave
  217.         If Index(pack,'0A'x) > 0 Then Leave /* ASCII LF */
  218.         If Index(pack,'0D'x) > 0 Then Leave /* ASCII CR */
  219.         path = path || pack
  220.     End
  221.     path = path || pack
  222.  
  223.     Parse Var path path '0A'x .     /* ASCII LF */
  224.     Parse Var path path '0D'x .     /* ASCII CR */
  225.     'PIPE VAR PATH | A2E | VAR PATH'
  226.  
  227.     /*  refresh disk access  (same procedure as used by GONE EXEC)  */
  228.     'PIPE CMS QUERY DISK | DROP | STEM STEM.'
  229.     Do i = 1 to stem.0
  230.         Parse Var stem.i . 8 va 12 fm .
  231.         If Left(va,3) = "DIR" Then Iterate
  232.         'DISKWRIT' Left(fm,1)
  233.         If rc = 1 Then 'ACCESS' va fm
  234.         End  /*  Do  For  */
  235.  
  236.     client = cipa
  237.     'GLOBALV SELECT GOPHERD PUT CLIENT'
  238.  
  239.  
  240. Parse Var path path '05'x parm
  241. Say argo "Requesting:" path
  242. If parm ^= "" Then Say argo "+ Parms:" parm
  243.  
  244. Select  /*  type  */
  245.  
  246.     When path = "" Then Do
  247.         type = '1'
  248.         logmsg = 121    /*  "Root Connection"  */
  249.         End  /*  When  ..  Do  */
  250.  
  251.     When Left(path,1) = '1' Then Do
  252.         Parse Var path 1 type 2 path
  253.         logmsg = 122    /*  "retrieved directory" path  */
  254.         End  /*  When  ..  Do  */
  255.  
  256.     When Left(path,1) = '7' Then Do
  257.         Parse Var path 1 type 2 path
  258.         logmsg = 125    /*  "searched directory" path  */
  259.         End  /*  When  ..  Do  */
  260.  
  261.     When Left(path,1) = '/' Then Do
  262.         type = '0'
  263.         logmsg = 123    /*  "retrieved file" path  */
  264.         End  /*  When  ..  Do  */
  265.  
  266.     Otherwise Do
  267.         Parse Var path 1 type 2 path
  268.         logmsg = 123    /*  "retrieved file" path  */
  269.         End  /*  Otherwise  Do  */
  270.  
  271.     End  /*  Select  type  */
  272.  
  273. 'GLOBALV SELECT GOPHERD PUT PATH PARM'
  274. 'GLOBALV SELECT GOPHERD SET MENU'
  275.  
  276. Select  /*  type  */
  277.  
  278.     When type = "0" Then        /* plain text file */
  279.         pipe = 'APPEND LITERAL .' || ,
  280.             '| E2A | SPEC 1-* 1 x0D0A NEXT'
  281.  
  282.     When type = "1" Then        /* menu */
  283.         pipe = 'GOPSRVMB | APPEND LITERAL .' || ,
  284.             '| E2A | SPEC 1-* 1 x0D0A NEXT'
  285.  
  286.     When type = "7" Then        /* menu with search */
  287.         pipe = 'GOPSRVYS' parm '| GOPSRVMB | APPEND LITERAL .' || ,
  288.             '| E2A | SPEC 1-* 1 x0D0A NEXT'
  289.  
  290.     When type = "9" | ,         /* binary */
  291.          type = "4" | ,         /* Mac file, send as binary */
  292.          type = "5" | ,         /* PC file, send as binary */
  293.          type = "I" | ,         /* send pictures as binary */
  294.          type = "s" Then        /* sound, send as binary */
  295. pipe = 'FBLOCK 8192'    /*  default processing  */
  296.  
  297.     When type = "p" Then        /* PostScript */
  298.         pipe = 'E2A | SPEC 1-* 1 x0D0A NEXT'
  299.  
  300.     When type = "r" | ,         /* record oriented file */
  301.          type = "v" Then        /* var-length records */
  302.         pipe = 'BLOCK 65531 CMS |' pipe
  303.  
  304.     Otherwise                   /* send it as binary */
  305. pipe = 'FBLOCK 8192'    /*  default processing  */
  306.  
  307.     End  /*  Select  type  */
  308.  
  309.     'PIPE GOPSRVLS' root '| GOPSRVRP' path ,
  310.             '|' pipe '| FBLOCK 8192 | STEM STEM.'
  311.  
  312. /*  If rc ^= 0 Then logrqest = logrqest "(rc=" || rc || ")"  */
  313.  
  314. 'PIPE COMMAND XMITMSG' logmsg 'DAY MON DD TIME YY CLIENT PATH' ,
  315.         '(APPLID GOP CALLER SRV ERRMSG |' logpipe
  316.  
  317.  
  318.     Say argo stem.0 "blocks to send"
  319.     /*
  320.      *   Send the response to our client
  321.      */
  322.     Do i = 1 to stem.0
  323.         bytes_out = Socket('Write', ns, stem.i)
  324.         If bytes_out = "-1" Then Do
  325.             Say argo tcperror()
  326.             Leave
  327.             End  /*  If  ..  Do  */
  328.         End  /*  Do  For  */
  329.  
  330.  
  331.     /*
  332.      *   All done, relinquish our socket descriptor
  333.      */
  334.     rc = Socket('Close', ns)
  335.     If rc = "-1" Then Do
  336.         Say argo tcperror()
  337.         Leave
  338.         End  /*  If  ..  Do  */
  339.     Say argo "Closed" ns "at" Time()
  340.  
  341.  
  342.     End  /*  Do  Forever  */
  343.  
  344.  
  345. /*
  346.  *   Tell RXSOCKET that we are done with this IUCV path
  347.  */
  348. rc = Socket('Terminate')
  349. If rc = "-1" Then Do
  350.     Say argo tcperror()
  351.     End  /*  If  ..  Do  */
  352.  
  353.  
  354. Exit
  355.  
  356.